home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 7 / FM Towns Free Software Collection 7.iso / data / happypas / life.pas < prev    next >
Pascal/Delphi Source File  |  1993-11-30  |  4KB  |  111 lines
  1. {*********************************************************************
  2.  *  ***  Rペントミノによる　ライフゲーム ***                         *
  3.  *          60 × 19 の宇宙で Rペントミノ を 変化させると            *
  4.  *           155世代目より6世代単位で繰り返す形に落ち着く            *
  5.  *                                                                   *
  6.  *        HAPPyのサンプルプログラム                                  *
  7.  *          (作者  浅野比富美 Public Domain Software)                *
  8.  *********************************************************************}
  9.  
  10. program LifeGame(input,output) ;
  11.  
  12.   const Xmax = 61 ;                { x軸(横軸の最大値 }
  13.         Ymax = 20 ;                { y軸(縦軸の最大値 }
  14.  
  15.   type  xRange = 0..Xmax ;         { x軸の範囲  (1～60までを使う) }
  16.         yRange = 0..Ymax ;         { y軸の範囲  (1～19までを使う) }
  17.  
  18.   var   CurUniv , PreUniv : array[xRange,yRange] of Boolean ;
  19.            { Current Universe : 現在の宇宙 Previous Universe :1世代前の宇宙 }
  20.         i : integer ;              { 世代カウンタ }
  21.         x : xRange  ;              { for文制御変数 }
  22.         y : yRange  ;              { for文制御変数 }
  23.  
  24.  {************************}
  25.  {* x行y桁にカーソル移動 *}
  26.  {************************}
  27.   procedure gotoxy(x{行},y{桁}:integer);
  28.     type string = packed array[1..2] of char ;
  29.     var  strX,strY: string ;
  30.     procedure make(n:integer; var str: string) ;
  31.     begin
  32.       str[1] := chr(n div 10 + ord('0')) ;
  33.       str[2] := chr(n mod 10 + ord('0')) ;
  34.     end {make} ;
  35.    begin {gotoxy}
  36.      make(x,strX) ;
  37.      make(y,strY) ;
  38.      write(chr(27),'[',strX,';',strY,'H')
  39.    end {gotoxy} ;
  40.  
  41.  {************************}
  42.  {*     初期設定処理     *}
  43.  {************************}
  44.   procedure Init ;
  45.     var x : xRange ;
  46.         y : yRange ;
  47.    begin
  48.      for x := 0 to Xmax do         { 全面クリア }
  49.        for y := 0 to Ymax do
  50.          CurUniv[x,y] := false ;
  51.      PreUniv := CurUniv ;          { 0世代出力のため }
  52.                                                      { Rペントミノ }
  53.      CurUniv[26, 8] := true ;  CurUniv[27, 8] := true ;  {   ○○  }
  54.      CurUniv[27, 9] := true ;  CurUniv[27,10] := true ;  { ○○    }
  55.      CurUniv[28, 9] := true                              {   ○    }
  56.    end {Init} ;
  57.  
  58.  {************************}
  59.  {*    次世代状態作成    *}
  60.  {************************}
  61.  {  ----- ライフゲーム創始者 コンウェイが考案した生成消滅規則 -----
  62.    現在が死の状態にあるセルは３性交渉によって新しく生に生まれ変わる。
  63.  　周囲の生のセルが３より多くても少なくても新しい生命は誕生しない。
  64.  　一方現在が生の状態にあるセルが次時刻でも延命するのは、周囲にほどほどの
  65.  　生命がある場合、すなわち周囲の生のセルの個数が２または３の時の限る。
  66.  　周囲にセルが２個未満であれば、過疎によって死に至る。また周囲に生のセルが
  67.  　４個以上あれば、過密によって死に至る。}
  68.  
  69.   procedure Next ;
  70.     var x     : xRange ;
  71.         y     : yRange ;
  72.         count : 0..8   ;           { 周囲のセル数 }
  73.   begin
  74.     PreUniv := CurUniv ;           { 現在の宇宙を退避 }
  75.     for x := 1 to Xmax-1 do
  76.       for y := 1 to Ymax-1 do
  77.       begin
  78.         count := ord(PreUniv[x-1,y-1]) + ord(PreUniv[x-1,y  ])
  79.                + ord(PreUniv[x-1,y+1]) + ord(PreUniv[x  ,y-1])
  80.                + ord(PreUniv[x  ,y+1]) + ord(PreUniv[x+1,y-1])
  81.                + ord(PreUniv[x+1,y  ]) + ord(PreUniv[x+1,y+1]) ;
  82.         if PreUniv[x,y] then CurUniv[x,y] := (count=2) or (count=3)
  83.                         else CurUniv[x,y] := (count=3)
  84.      end
  85.   end {Next} ;
  86.  
  87. {************************}
  88. {*    メイン処理        *}
  89. {************************}
  90. begin {main}
  91.   Init ;                           { 初期設定     }
  92.   page ;                           { 画面クリア   }
  93.   writeln('*************　Ｒペントミノによる　ライフゲーム　*************') ;
  94.   for i:=0 to 155+6 do             { 155世代目から6世代で終わり }
  95.   begin
  96.     gotoxy(2,1) ;
  97.     writeln(i:3,'世代');
  98.     for y := 0 to Ymax do
  99.     begin
  100.       for x := 0 to Xmax do
  101.         if CurUniv[x,y] <> PreUniv[x,y] then { 前回と異なっている時 }
  102.         begin
  103.           gotoxy(3+y,x+1) ;        { 対応場所にカーソルを移動 }
  104.           if CurUniv[x,y] then write('O')    { 生 }
  105.                           else write(' ')    { 死 }
  106.         end
  107.     end ;
  108.     Next                           { 次世代を作成 }
  109.   end
  110. end.
  111.